TidyTuesday
Data wrangling with #TidyTuesday data sets
Antti Karkman, 2020
Week 43 - Beer Awards
Read in the data
beer_awards <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-10-20/beer_awards.csv')Take a look at the data
beer_awards <- beer_awards %>% mutate(state=str_to_upper(state))
glimpse(beer_awards)## Rows: 4,970
## Columns: 7
## $ medal <chr> "Gold", "Silver", "Bronze", "Gold", "Silver", "Bronze", "Go…
## $ beer_name <chr> "Volksbier Vienna", "Oktoberfest", "Amber Lager", "Lager at…
## $ brewery <chr> "Wibby Brewing", "Founders Brewing Co.", "Skipping Rock Bee…
## $ city <chr> "Longmont", "Grand Rapids", "Staunton", "Concord", "Santa R…
## $ state <chr> "CO", "MI", "VA", "CA", "CA", "IL", "CA", "TX", "OR", "MO",…
## $ category <chr> "American Amber Lager", "American Amber Lager", "American A…
## $ year <dbl> 2020, 2020, 2020, 2020, 2020, 2020, 2020, 2020, 2020, 2020,…Map
US_map <- map_data("state")
US_states <- tibble(region=datasets::state.name, state=datasets::state.abb)
US_states <- US_states %>% mutate(region=str_to_lower(region))
beer_data <- full_join(beer_awards, US_states, by="state")
gold_count <- beer_data %>% filter(medal=="Gold") %>% dplyr::count(region)
state_gold_count <- left_join(US_map, gold_count, by="region")
ggplot() +
geom_polygon(data = state_gold_count, aes(x=long, y = lat, group=group, fill=n), color="grey40") +
theme_classic() + scale_fill_scico(palette = 'lajolla', begin=0.1, end=0.7) +
labs(title="GABF Gold Medal Winners in 1987 - 2020",
fill= "Gold Medals by State", caption="Data Source: Great American Beer Festival") +
theme(legend.position="bottom", axis.ticks=element_blank(), axis.line=element_blank(),
axis.text=element_blank(), axis.title=element_blank(),
text = element_text(family="Courier"))
Word clouds
Wordclouds from beer names
All beers
beer_name_freq <- beer_data %>% pull(beer_name) %>% str_split(" ") %>% unlist() %>% table() %>% data.frame()
beer_name_freq <- beer_name_freq[order(beer_name_freq[,2], decreasing=TRUE),]
beer_name_freq <- beer_name_freq %>% filter(.!="IPA", .!="Porter", .!="Lager", .!="Stout", .!="Ale", .!="Pale")
wordcloud(beer_name_freq[,1], beer_name_freq[,2], max.words=100, colors=scico(5, palette = 'lajolla', begin=0.2, end=0.7), random.order=FALSE, rot.per=0.3, min.freq=1)
Gold medalists
beer_name_freq <- beer_data %>% filter(medal=="Gold") %>% pull(beer_name) %>% str_split(" ") %>% unlist() %>% table() %>% data.frame()
beer_name_freq <- beer_name_freq[order(beer_name_freq[,2], decreasing=TRUE),]
beer_name_freq <- beer_name_freq %>% filter(.!="IPA", .!="Porter", .!="Lager", .!="Stout", .!="Ale", .!="Pale")
wordcloud(beer_name_freq[,1], beer_name_freq[,2], max.words=100, colors=scico(5, palette = 'lajolla', begin=0.2, end=0.7), random.order=FALSE, rot.per=0.3, min.freq=1)
IPAs
beer_name_freq <- beer_data %>% filter(category=="American-Style India Pale Ale") %>% pull(beer_name) %>% str_split(" ") %>% unlist() %>% table() %>% data.frame()
beer_name_freq <- beer_name_freq[order(beer_name_freq[,2], decreasing=TRUE),]
beer_name_freq <- beer_name_freq %>% filter(.!="IPA")
wordcloud(beer_name_freq[,1], beer_name_freq[,2], max.words=100, colors=scico(5, palette = 'lajolla', begin=0.2, end=0.7), random.order=FALSE, rot.per=0.3, min.freq=1)
Light lagers
beer_name_freq <- beer_data %>% filter(category=="American-Style Light Lager") %>% pull(beer_name) %>% str_split(" ") %>% unlist() %>% table() %>% data.frame()
beer_name_freq <- beer_name_freq[order(beer_name_freq[,2], decreasing=TRUE),]
wordcloud(beer_name_freq[,1], beer_name_freq[,2], max.words=100, colors=scico(5, palette = 'lajolla', begin=0.2, end=0.7), random.order=FALSE, rot.per=0.3, min.freq=1)
Week 45 - IKEA Furniture
One liner to plot the top 20 designers for IKEA.
read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-11-03/ikea.csv') %>% dplyr::count(designer) %>% arrange(by=n) %>% data.frame() %>% tail(20) %>% ggplot(aes(fct_reorder(designer, n), y=n)) + geom_bar(stat="identity", color="#ffcc00", fill="#ffcc00", width=0.75) + coord_flip() + theme_classic() + labs(y="", x="", title="TidyTuesday - Week 45", subtitle="Top 20 designers for IKEA furnitures", caption="Data Source: Kaggle") + scale_y_continuous(expand=c(0,0)) + theme(axis.line=element_blank(), axis.ticks=element_blank(), plot.title=element_text(size=25, face="bold", family="Verdana", colour="#003399"), plot.subtitle=element_text(size=20, face="bold", family="Verdana", colour="#003399"), plot.caption=element_text(size=10, family="Verdana", colour="#003399"), axis.text=element_text(size=15, face="bold", family="Verdana", colour="#003399"))
Update with more IKEA like appearance.
read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-11-03/ikea.csv') %>% dplyr::count(designer) %>% arrange(by=n) %>% data.frame() %>% tail(20) %>% ggplot(aes(fct_reorder(designer, n), y=n)) + geom_bar(stat="identity", color="#003399", fill="#003399", width=0.75) + coord_flip() + theme_classic() + labs(y="", x="", title="TidyTuesday - Week 45", subtitle="Top 20 Designers for IKEA Furnitures", caption="Data Source: Kaggle") + scale_y_continuous(expand=c(0,0)) + theme(axis.line=element_blank(), axis.ticks=element_blank(), plot.title=element_text(size=25, face="bold", family="Verdana", colour="#003399"), plot.subtitle=element_text(size=20, face="bold", family="Verdana", colour="#003399"), plot.caption=element_text(size=10, family="Verdana", colour="#003399"), axis.text=element_text(size=15, face="bold", family="Verdana", colour="#003399"), plot.background=element_rect(fill="#ffcc00"),panel.background=element_rect(fill="#ffcc00"))
Week 46 - Historical Phone Usage
The Data and Nokia Font
Read in the data and Nokia font
mobile <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-11-10/mobile.csv')
glimpse(mobile)## Rows: 6,277
## Columns: 7
## $ entity <chr> "Afghanistan", "Afghanistan", "Afghanistan", "Afghanistan…
## $ code <chr> "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "…
## $ year <dbl> 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 199…
## $ total_pop <dbl> 13032161, 14069854, 15472076, 17053213, 18553819, 1978988…
## $ gdp_per_cap <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1063.636,…
## $ mobile_subs <dbl> 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.…
## $ continent <chr> "Asia", "Asia", "Asia", "Asia", "Asia", "Asia", "Asia", "…landline <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-11-10/landline.csv')
glimpse(landline)## Rows: 6,974
## Columns: 7
## $ entity <chr> "Afghanistan", "Afghanistan", "Afghanistan", "Afghanist…
## $ code <chr> "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG",…
## $ year <dbl> 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1…
## $ total_pop <dbl> 12412000, 13299000, 14486000, 15817000, 17076000, 18111…
## $ gdp_per_cap <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1063.63…
## $ landline_subs <dbl> 0.29553158, 0.28475432, 0.20742093, 0.19211533, 0.17931…
## $ continent <chr> "Asia", "Asia", "Asia", "Asia", "Asia", "Asia", "Asia",…font_add("Nokia", "./fonts/Nokia.ttf")
showtext_auto()Some Wrangling
phones <- full_join(mobile, landline[,c("code", "year","landline_subs")], by=c("code", "year"))
glimpse(phones)## Rows: 7,036
## Columns: 8
## $ entity <chr> "Afghanistan", "Afghanistan", "Afghanistan", "Afghanist…
## $ code <chr> "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG",…
## $ year <dbl> 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1…
## $ total_pop <dbl> 13032161, 14069854, 15472076, 17053213, 18553819, 19789…
## $ gdp_per_cap <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1063.63…
## $ mobile_subs <dbl> 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, …
## $ continent <chr> "Asia", "Asia", "Asia", "Asia", "Asia", "Asia", "Asia",…
## $ landline_subs <dbl> 0.29553158, 0.28475432, 0.20742093, 0.19211533, 0.17931…phones <- phones %>% mutate(ratio = mobile_subs/landline_subs)
glimpse(phones)## Rows: 7,036
## Columns: 9
## $ entity <chr> "Afghanistan", "Afghanistan", "Afghanistan", "Afghanist…
## $ code <chr> "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG",…
## $ year <dbl> 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1…
## $ total_pop <dbl> 13032161, 14069854, 15472076, 17053213, 18553819, 19789…
## $ gdp_per_cap <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1063.63…
## $ mobile_subs <dbl> 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, …
## $ continent <chr> "Asia", "Asia", "Asia", "Asia", "Asia", "Asia", "Asia",…
## $ landline_subs <dbl> 0.29553158, 0.28475432, 0.20742093, 0.19211533, 0.17931…
## $ ratio <dbl> 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, …Mobile Phones and GDP
colors <- scico(5, palette = 'vik')
phones %>% filter(year=="2000") %>% ggplot(aes(x=gdp_per_cap, y=mobile_subs, fill=continent)) +
geom_point(size=3, pch=21, col="white") + theme_void() +
labs(x="GDP per capita", y="Mobiles per 100 ppl", title="Connecting People",
subtitle="Mobile phones per GDP in 2000", caption = "Source\n OurWorldInData.org") +
theme(text=element_text(family="Nokia", color="#183693"),
axis.title.y=element_text(size=10, angle=90, vjust=2),
axis.title.x=element_text(size=10, vjust=-2),
plot.title=element_text(size=20),
plot.subtitle=element_text(size=15),
plot.caption=element_text(size=10),
axis.text=element_blank(), legend.position="bottom",
legend.text=element_text(size=10),
plot.margin=unit(c(0.5,0.5,1,1), units="cm")) +
scale_fill_manual(name="", values=colors)
World Map
world <- map_data("world") %>% filter(region!="Antarctica")
colnames(world)[5] <- "entity"
phones$entity <- recode(phones$entity, "United States" = "USA", "United Kingdom" = "UK")
phones_map <- full_join(phones, world, by="entity")
phones_map %>% filter(year=="2000") %>% ggplot() +
geom_polygon(aes(x=long, y = lat, group = group, fill=mobile_subs), color="grey40") + theme_void() +
coord_equal() +
labs(x="", y="", title="Connecting People",
subtitle="Mobile phone subscriptions per 100 ppl in 2000",
caption = "Source\n OurWorldInData.org") +
theme(text=element_text(family="Nokia", color="#183693"),
axis.title.y=element_text(size=10, angle=90, vjust=2),
axis.title.x=element_text(size=10, vjust=-2),
plot.title=element_text(size=20),
plot.subtitle=element_text(size=15),
plot.caption=element_text(size=10),
axis.text=element_blank(), legend.position="bottom",
legend.text=element_text(size=10),
legend.title=element_blank()) +
scale_x_continuous(limits=c(-150, 200)) +
scale_fill_gradient(breaks=c(0, 40, 80), na.value="white")
Animated World Map
anim <- phones_map %>% filter(year<2018) %>% ggplot() +
geom_polygon(aes(x = long, y = lat, group = group, fill=mobile_subs)) +
#geom_polygon(data=world, aes(x = long, y = lat, group = group), fill=NA, color="grey40") +
coord_equal() + transition_manual(year) + theme_void() +
labs(x="", y="", title="Connecting People",
subtitle="Mobile phone subscriptions in {current_frame}", caption = "Source\n OurWorldInData.org") +
theme(text=element_text(family="Nokia", color="#183693"),
plot.title=element_text(size=20),
plot.subtitle=element_text(size=15),
plot.caption=element_text(size=10),
legend.position="none",
legend.title=element_blank()) +
scale_x_continuous(limits=c(-150, 200)) +
scale_fill_gradient(na.value="white")Save the animation
animate(anim, 200, fps = 10, width = 1200, height = 800,
renderer = gifski_renderer("mobiles_map.gif"), end_pause = 2, start_pause = 2)
showtext_auto(FALSE)
sessionInfo()## R version 3.6.2 (2019-12-12)
## Platform: x86_64-apple-darwin15.6.0 (64-bit)
## Running under: macOS Mojave 10.14.6
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/3.6/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/3.6/Resources/lib/libRlapack.dylib
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] transformr_0.1.2.9000 gganimate_1.0.6 showtext_0.9
## [4] showtextdb_3.0 sysfonts_0.8.1 wordcloud_2.6
## [7] RColorBrewer_1.1-2 scico_1.2.0.9000 patchwork_1.0.1
## [10] forcats_0.5.0 stringr_1.4.0 dplyr_1.0.2
## [13] purrr_0.3.4 readr_1.3.1 tidyr_1.1.2
## [16] tibble_3.0.3 ggplot2_3.3.2 tidyverse_1.3.0
##
## loaded via a namespace (and not attached):
## [1] httr_1.4.2 maps_3.3.0 jsonlite_1.7.1 modelr_0.1.8
## [5] assertthat_0.2.1 blob_1.2.1 cellranger_1.1.0 yaml_2.2.1
## [9] progress_1.2.2 pillar_1.4.6 backports_1.1.10 glue_1.4.2
## [13] digest_0.6.25 rvest_0.3.6 colorspace_1.4-1 htmltools_0.5.0
## [17] lpSolve_5.6.15 pkgconfig_2.0.3 broom_0.7.0 gifski_0.8.6
## [21] haven_2.3.1 scales_1.1.1 tweenr_1.0.1 generics_0.0.2
## [25] farver_2.0.3 ellipsis_0.3.1 withr_2.2.0 cli_2.0.2
## [29] magrittr_1.5 crayon_1.3.4 readxl_1.3.1 evaluate_0.14
## [33] fs_1.5.0 fansi_0.4.1 class_7.3-17 xml2_1.3.2
## [37] tools_3.6.2 prettyunits_1.1.1 hms_0.5.3 lifecycle_0.2.0
## [41] munsell_0.5.0 reprex_0.3.0 e1071_1.7-4 compiler_3.6.2
## [45] rlang_0.4.8 units_0.6-7 classInt_0.4-3 grid_3.6.2
## [49] rstudioapi_0.11 labeling_0.3 rmarkdown_2.3 gtable_0.3.0
## [53] DBI_1.1.0 curl_4.3 R6_2.4.1 lubridate_1.7.9
## [57] knitr_1.29 utf8_1.1.4 KernSmooth_2.23-17 stringi_1.5.3
## [61] Rcpp_1.0.5 vctrs_0.3.4 sf_0.9-6 dbplyr_1.4.4
## [65] tidyselect_1.1.0 xfun_0.17